Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH11/SRC/OBJPICT1.CLS

Text File | 1996-05-04 | 5KB | 187 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjPicture"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Public Objects As New Collection

Const TYPE_STRING = "3D APF PICTURE"

' ***********************************************
' Create normals for polygon objects.
' ***********************************************
Sub CreateNormal()
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Or _
           obj.ObjectType = "POLYGON" Then _
                obj.CreateNormal Objects
    Next obj
End Sub


Property Let Culled(value As Boolean)
Dim obj As Object

    For Each obj In Objects
        obj.Culled = value
    Next obj
End Property




' ************************************************
' Find an object that contains this point.
' ************************************************
Function NearestObject(X As Single, Y As Single) As Object
Dim obj As Object

    ' Find the object.
    For Each obj In Objects
        If obj.Contains(X, Y) Then
            Set NearestObject = obj
            Exit Function
        End If
    Next obj
    Set NearestObject = Nothing
End Function


Function ObjectType() As String
    ObjectType = TYPE_STRING
End Function


' ************************************************
' Save the objects in the picture into a metafile.
' ************************************************
Sub MakeWMF(mhdc As Integer)
Dim obj As Object

    For Each obj In Objects
        obj.MakeWMF mhdc
    Next obj
End Sub

' ************************************************
' Read the picture from a file using Input.
' Assume TYPE_STRING has already been read.
' ************************************************
Sub FileInput(filenum As Integer)
Dim num As Integer
Dim i As Integer
Dim obj As Object
Dim obj_type As String

    ' Read the number of objects in the file.
    Input #filenum, num

    ' Repeatedly read objects from the file.
    For i = 1 To num
        Input #filenum, obj_type
        Select Case obj_type
            Case TYPE_STRING
                Set obj = New ObjPicture
            Case "POLYLINE"
                Set obj = New ObjPolyline
            Case "SOLID"
                Set obj = New ObjSolid
            Case Else
                Beep
                MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
                Exit Sub
        End Select
        obj.FileInput filenum
        Objects.Add obj
    Next i
End Sub

' ************************************************
' Draw the picture on a Form, Printer, or
' PictureBox.
' ************************************************
Sub Draw(canvas As Object, Optional r As Variant)
Dim obj As Object

    For Each obj In Objects
        obj.Draw canvas, r
    Next obj
End Sub
Public Sub ClipEye(r As Single)
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Then _
            obj.ClipEye r
    Next obj
End Sub

' ************************************************
' Perform backface removal on the solids.
' ************************************************
Public Sub Cull(X As Single, Y As Single, z As Single)
Dim obj As Object

    For Each obj In Objects
        If obj.ObjectType = "SOLID" Then _
            obj.Cull X, Y, z
    Next obj
End Sub

' ************************************************
' Write the picture to a file using Write.
' Begin with TYPE_STRING to identify this object.
' ************************************************
Sub FileWrite(filenum As Integer)
Dim obj As Object

    Write #filenum, TYPE_STRING
    Write #filenum, Objects.Count

    For Each obj In Objects
        obj.FileWrite filenum
    Next obj
End Sub

' ************************************************
' Apply a nonlinear transformation to the objects.
' ************************************************
Sub Distort(trans As Object)
Dim obj As Object

    For Each obj In Objects
        obj.Distort trans
    Next obj
End Sub


' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' objects.
' ************************************************
Sub ApplyFull(M() As Single)
Dim obj As Object

    For Each obj In Objects
        obj.ApplyFull M
    Next obj
End Sub
' ************************************************
' Apply a transformation matrix to the objects.
' ************************************************
Sub Apply(M() As Single)
Dim obj As Object

    For Each obj In Objects
        obj.Apply M
    Next obj
End Sub